perm filename LST[PAT,LMM] blob sn#066033 filedate 1973-10-09 generic text, type T, neo UTF8
PP
  [LAMBDA (RECEXPR FIELD SETQFLG)
    (PROG (TEM1 TEM2 DECLST)  **COMMENT**  
      RETRY
          [COND
            ((AND FIELD (NLISTP FIELD))
              (COND
                ([AND (SETQ DECLST (GETLOCALDEC EXPR FAULTFN))
                      (SETQ TEM1 (CLISPLOOKUP0 FIELD RECEXPR NIL DECLST 
                                               NIL (QUOTE RECORDFIELD]
  **COMMENT**  
                  (SETQ TEM2 (RECORDECL TEM1)))
                ([FMEMB FIELD (CAR (SETQ TEM2
                                     (RECORDECL (SETQ TEM1
                                                  (GETP FIELD
                                                        (QUOTE 
                                                        CLISPRECORD]
  **COMMENT**  
                  (OR RECORDTRANFLG (GO GLOBAL)))
                ((SETQ TEM1 (RECRESPELL FIELD DECLST NIL))
                  (SETQ FIELD TEM1)
                  (GO RETRY))
                [(SETQ TEM1 (GETP FIELD (QUOTE ACCESSFN)))
                  [AND (ATOM TEM1)
                       (SETQ TEM1 (GETP TEM1 (QUOTE ACCESSFN]
                  (RETURN (COND
                            (SETQFLG (LIST (QUOTE replace)
                                           (QUOTE ACCESSFN)
                                           (OR (CDR (LISTP TEM1))
                                               (HELP))
                                           RECEXPR))
                            (T (LIST (COND
                                       ((NLISTP TEM1)
                                         TEM1)
                                       (T (CAR TEM1)))
                                     RECEXPR]
                (T (RETURN)))
              (AND SETQFLG (RETURN (LIST (QUOTE replace)
                                         FIELD TEM1 RECEXPR)))
              (SETQ RECEXPR (LIST (QUOTE fetch)
                                  FIELD
                                  (QUOTE of)
                                  RECEXPR)))
            (SETQFLG [COND
                       ((OR (NEQ (CAR RECEXPR)
                                 (QUOTE replace))
                            (NOT SETQFLG))
                         (HELP   **COMMENT**  ]
                     [COND
                       ((EQ (CADR RECEXPR)
                            (QUOTE GLOBAL))
                         (GO GLOBAL2))
                       ((EQ (CADR RECEXPR)
                            (QUOTE ACCESSFN))
                         (FRPLACD (CDDDR RECEXPR)
                                  FIELD)
                         (RETURN (CDDR RECEXPR]  **COMMENT**  
                     (SETQ TEM1 (CADDR RECEXPR))
                     (FRPLACA (CDDR RECEXPR)
                              (QUOTE of))
                     (SETQ TEM2 (RECORDECL TEM1))
                     (FRPLACD (CDDDR RECEXPR)
                              (CONS (QUOTE with)
                                    FIELD)))
            (T   **COMMENT**  
               (SETQ TEM1 (OR (AND (SETQ DECLST (GETLOCALDEC EXPR 
                                                            FAULTFN))
                                   (CLISPLOOKUP0 (CADR RECEXPR)
                                                 (CADDDR RECEXPR)
                                                 NIL DECLST NIL
                                                 (QUOTE RECORDFIELD)))
                              (GETP (CADR RECEXPR)
                                    (QUOTE CLISPRECORD))
                              (AND (RECRESPELL (CADR RECEXPR)
                                               DECLST
                                               (CDR RECEXPR))
                                   (GO RETRY))
                              (RETURN)))
               (SELECTQ (CADDR RECEXPR)
                        ((of OF))
                        (OR (FIXSPELL (CADDR RECEXPR)
                                      70
                                      (QUOTE (of OF))
                                      NIL
                                      (CDDR RECEXPR)
                                      NIL T)
                            (RETURN)))
               (SELECTQ (CAR RECEXPR)
                        [(REPLACE replace)
                          (SELECTQ (CAR (CDDDDR RECEXPR))
                                   ((with WITH))
                                   (OR (FIXSPELL (CAR (CDDDDR RECEXPR))
                                                 70
                                                 (QUOTE (with WITH))
                                                 NIL
                                                 (CDDDDR RECEXPR)
                                                 NIL T)
                                       (RETURN]
                        ((FETCH fetch))
                        (HELP   **COMMENT**  ]
          (SETQ TEM1 (OR TEM2 (RECORDECL TEM1)
                         (HELP)))  **COMMENT**  
          [OR (CDDDR TEM1)
              (FRPLACD (CDDR TEM1)
                       (FIELDDEFS (CADDR TEM1]
          [OR (SETQ TEM1 (FASSOC (CADR RECEXPR)
                                 (CDDDR TEM1)))
              (HELP   **COMMENT**  ]
          (CLISPTRAN
            RECEXPR
            (SELECTQ
              (CAR RECEXPR)
              ((REPLACE replace)
                [OR (CDDR TEM1)
                    (RPLACD (CDR TEM1)
                            (LIST (MAKERPLAC2 (CADR TEM1]
                [SETQ TEM2
                  (CONS [COND
                          ((AND (SETQ CLASS (GETP (CAR TEM)
                                                  (QUOTE CLISPCLASS)))
                                (SETQ TEM (GETLOCALDEC EXPR FAULTFN)))
                            (CLISPLOOKUP0 (CAR TEM)
                                          (CADDDR RECEXPR)
                                          NIL TEM (GETP (CAR TEM1)
                                                        'LISPFN)
                                          CLASS))
                          (T (OR (GETP (CAR TEM1)
                                       'LISPFN)
                                 (CAR TEM]
                        (CONS (COND
                                [(LISTP (CADR TEM1))
                                  (PROG [(SUBSTEXPR
                                           (LIST (CADDDR RECEXPR]
                                        (OR (MYSUBST (CADR TEM1))
                                            (HELP]
                                (T (CADDDR RECEXPR)))
                              (CDR (CDDDDR RECEXPR]
                (COND
                  (RECORDREPLACEVALUEFLG (LIST (SELECTQ (CAR TEM2)
                                                        ((RPLACA 
                                                            /RPLACA 
                                                            FRPLACA)
                                                          (QUOTE CAR))
                                                        ((RPLACD 
                                                            /RPLACD 
                                                            FRPLACD)
                                                          (QUOTE CDR))
                                                        (HELP))
                                               TEM2))
                  (T TEM2)))
              [(FETCH fetch)
                (PROG ((SUBSTEXPR (CDDDR RECEXPR)))
                      (OR (MYSUBST (CADR TEM1))
                          (HELP]
              (ERROR!)))
          (RETURN RECEXPR)
      GLOBAL2
          (RETURN (CONS (RECORDCLISPLOOKUP
                          [SETQ TEM1 (CAR (CDDDDR (CAR (CDDDDR RECEXPR]
                          (CADDR RECEXPR)
                          NIL
                          (GETP TEM1 (QUOTE LISPFN)))
                        (CONS (CADDR RECEXPR)
                              FIELD)))
      GLOBAL
          (COND
            (SETQFLG (RETURN (LIST (QUOTE replace)
                                   (QUOTE GLOBAL)
                                   RECEXPR FIELD TEM1)))
            ([NOT (FGETD (SETQ TEM1 (CADDDR (FASSOC
                                              FIELD
                                              (CDDDR (RECORDECL TEM1]
              (HELP))
            (T (RETURN (LIST TEM1 RECEXPR]
*